The X-Philes (2nd Revision)/The X-Philes Number 1 (1995).iso/xphiles/hp48_1/fraction

Internet Message Format | 1995-03-31 | 14KB

From hpcvbbs!davev Tue Jun  5 08:46 PDT 1990
Received: from hpcvra.HP.COM by hpcvrz.HP.COM; Tue, 5 Jun 90 08:46:23 pdt
Received: by hpcvra.HP.COM; Tue, 5 Jun 90 08:46:37 pdt
Received: from hpcvbbs with uucp; Tue, 5 Jun 90 08:39:38
Received: by hpcvbbs.HP.COM; Tue, 5 Jun 90 08:39:38 pdt
Date: Tue, 5 Jun 90 08:39:38 pdt
From: Dave Vomocil <hpcvbbs!davev>
Message-Id: <[e-mail]>
To: hpcvbbs!davev
Subject: frac.doc
Status: R



~% The attached programs can be used to turn your HP48SX into a four
function RPN machine that handles fractions graphically.  That is,
you will be able perform computations on mixed numbers the way you did
in grade school.  The pieces (i.e. files/programs) you need are:

~% GCD  computes greatest common divisor
~% LCM  computes least common multiple

~% (you should be getting a feeling of nostalgia by now :-)

~% PLUS~ used to add two mixed numbers
~% SUBTR  used to subtract two mixed numbers
~% MULTI  used to multiply two mixed numbers
~% DIVI~ used to divide two mixed numbers
~% DPLAY  used to display a mixed number
~% SWAPR  used to 'swap' two mixed numbers on the stack
~% DISPL  common display code used by DPLAY, PLUS, SUBTR, etc.
~% ADD~$ common arithmetic code used by PLUS and SUBTR.

~% KEYS~ this is a list you can hand to STOK to assign values
~, to your 'user' keys.

How to get your calculator set up:
~% Download the attached item to your PC and then on to your 48SX.
~% You should get the 48 item FRAC.  Recall it to your stack.
~% Get to your HOME directory.  Press EVAL.

~% This will create the above list of items in your home directory,
~% and it will assign user values to the '+', '-', '*', '/',
~% <left shift> <review>, and <swap> user keys.  If you have existing
~% values assigned to these keys, they will get clobbered.  Of you
~% have items in your HOME directory with conflicting names, they
~% will get clobbered.

~% You should place these items in your home directory so you will
~% always have access to them.

~% <left shift> <usr> <left shift> <usr> to activate your user key
~% assignments.

How to do fractions:
~% The software looks to the stack for arguments.  It uses three levels
~% to define a mixed number.  It wants the whole number in level three,
~% the numerator in level two, and the denominator in level one.

~% The operators '+', '-', '*', '/' and 'swap' expect two mixed numbers
~% on the stack.  The arithmetic operators leave only the result on the
~% stack.

~% The <left shift> <review> operator displays the mixed number in
~% levels 1, 2, & 3; and leaves it the stack unchanged.

Example:

~% Press:  1 <spc> 2 <spc> 3 <enter> <left shift> <review>

~% And see one and two thirds displayed.

~% Then press 4 <spc> 5 <spc> 6 +

~% And see one and two thirds plus four and five sixths equals
~% six and one half.

Bugs:
~% The whole number must be positive.  The software does not handle
~% a negative mixed number correctly.  For example, it says six and
~% one half plus a negative three and on half equals four.

~1. dave vomocil


%%HP: T(3)A(D)F(.);

\<<

@ Each mixed number is a list of size three.
3 \->LIST 4 ROLLD 3 \->LIST SWAP

@ Check that both denom's are non-zero.
DUP2 3 GET SWAP 3 GET AND IF NOT
THEN
   440 .5 BEEP
   "PLUS: zero in denom" 1 DISP 1 FREEZE
ELSE

    64 R\->B 131 R\->B BLANK PICT STO  @ Blank a 64X131 PICT

    @ Display the first addend
    SWAP 0 DISPL SWAP

    @ Now figure out where to place the + sign
    1 GETI SWAP DROP \->STR SIZE 2 + 6 * NEG 65 + R\->B
    20 R\->B 2 \->LIST PICT SWAP
    " + " 3 \->GROB                         @ GOR the + sign into PICT
    GOR

    @ And now the second addend
    15 DISPL
    25 R\->B 30 R\->B 2 \->LIST
    85 R\->B 30 R\->B 2 \->LIST LINE

    @ ADD the two mixed numbers and DISPL the sum.

    @ Compute LCM of denominators
    DUP 3 GET 3 ROLL DUP 3 GET 3 ROLL LCM 0 DUP \-> lcm numer carry
    \<<

    @ Compute numerator of fraction 1
    2 GETI 3 ROLLD GETI SWAP DROP
    lcm SWAP / 3 ROLL * 'numer' STO

    @ Compute numerator of fraction 2 and add
    SWAP 2 GETI 3 ROLLD GETI SWAP DROP
    lcm SWAP / 3 ROLL * numer + 'numer' STO

    @ Check for carry and reduce fraction part
    numer lcm / IP 'carry' STO
    numer lcm MOD 'numer' STO
    numer lcm GCD  DUP

    @ Reduce if non-zero GCD
    DUP IF THEN
         numer SWAP / 'numer' STO
         lcm SWAP / 'lcm' STO
       ELSE
         DROP2
       END

    @ Add the whole numbers and the carry
    1 GET SWAP 1 GET + carry +

    @ Form the mixed number list
    numer lcm 3 \->LIST

    \>> @ end of scope of lcm numer and carry

    @ DISPL the result
    32 DISPL

@ Convert the list to elements on the stack.
OBJ\-> DROP

END
\>> 'PLUS' STO


\<<

@ Convert elements on the stack to two lists
3 \->LIST 4 ROLLD 3 \->LIST SWAP

@ Check that both denom's are non-zero.
DUP2 3 GET SWAP 3 GET AND IF NOT
THEN
   440 .5 BEEP
   "SUBTR: zero in denom" 1 DISP 1 FREEZE
ELSE

    64 R\->B 131 R\->B BLANK PICT STO  @ Blank a 64X131 PICT

    @ Display the first minuend
    SWAP 0 DISPL SWAP

    @ Now figure out where to place the - sign
    1 GETI SWAP DROP \->STR SIZE 2 + 6 * NEG 65 + R\->B
    20 R\->B 2 \->LIST PICT SWAP
    " - " 3 \->GROB                         @ GOR the + sign into PICT
    GOR

    @ And now the second subtrahend
    15 DISPL
    25 R\->B 30 R\->B 2 \->LIST
    85 R\->B 30 R\->B 2 \->LIST LINE

    @ ADD the two mixed numbers and DISPL the sum.

    @ Compute LCM of denominators
    DUP 3 GET 3 ROLL DUP 3 GET 3 ROLL LCM 0 DUP \-> lcm numer borrow
    \<<

    @ Compute numerator of fraction 1
    2 GETI 3 ROLLD GETI SWAP DROP
    lcm SWAP / 3 ROLL * 'numer' STO

    @ Compute numerator of fraction 2
    SWAP 2 GETI 3 ROLLD GETI SWAP DROP
    lcm SWAP / 3 ROLL *  numer SWAP - DUP

    @ Determine if we need to borrow
    WHILE 0 <
       REPEAT lcm + DUP 'borrow' 1 STO+ END
    'numer' STO

    @ Reduce fraction part
    numer lcm GCD  DUP

    @ Reduce if non-zero GCD
    DUP IF THEN
         numer SWAP / 'numer' STO
         lcm SWAP / 'lcm' STO
       ELSE
         DROP2
       END

    @ Subtract the whole numbers
    SWAP 1 GET SWAP 1 GET - borrow -

    @ Form the mixed number list
    numer lcm 3 \->LIST

    \>> @ end of scope of lcm numer and carry

    @ DISPL the result
    32 DISPL

@ Convert the list to elements on the stack
OBJ\-> DROP

END
\>> 'SUBTR' STO

\<<

@ Compute LCM of denominators
DUP 3 GET 3 ROLL DUP 3 GET 3 ROLL LCM 0 DUP \-> lcm numer carry
\<<

@ Compute numerator of fraction 1
2 GETI 3 ROLLD GETI SWAP DROP
lcm SWAP / 3 ROLL * 'numer' STO

@ Compute numerator of fraction 2 and add
SWAP 2 GETI 3 ROLLD GETI SWAP DROP
lcm SWAP / 3 ROLL * numer + 'numer' STO

@ Check for carry and reduce fraction part
numer lcm / IP 'carry' STO
numer lcm MOD 'numer' STO
numer lcm GCD  DUP

@ Reduce if non-zero GCD
DUP IF THEN
         numer SWAP / 'numer' STO
         lcm SWAP / 'lcm' STO
       ELSE
     DROP2
       END

@ Add the whole numbers and the carry
1 GET SWAP 1 GET + carry +

@ Form the mixed number list
numer lcm 3 \->LIST

\>> @ end of scope of lcm numer and carry
\>> 'ADD' STO

\<<

@ Convert the elements on the stack to two lists.
3 \->LIST 4 ROLLD 3 \->LIST SWAP

@ Check that both denom's are non-zero.
DUP2 3 GET SWAP 3 GET AND IF NOT
THEN
   440 .5 BEEP
   "SUBTR: zero in denom" 1 DISP 1 FREEZE
ELSE

    64 R\->B 131 R\->B BLANK PICT STO  @ Blank a 64X131 PICT

    @ Display the first mmultiplier
    SWAP 0 DISPL SWAP

    @ Now figure out where to place the * sign
    1 GETI SWAP DROP \->STR SIZE 2 + 6 * NEG 65 + R\->B
    20 R\->B 2 \->LIST PICT SWAP
    " * " 3 \->GROB                         @ GOR the + sign into PICT
    GOR

    @ And now the second multiplier
    15 DISPL
    25 R\->B 30 R\->B 2 \->LIST
    85 R\->B 30 R\->B 2 \->LIST LINE

    @ Multiply the two mixed numbers and DISPL the sum.

    @ Convert the two mixed numbers to improper fractions.
    3 GETI 3 ROLLD GETI 4 ROLL * 3 ROLLD GETI 4 ROLL +
    SWAP DROP 2 SWAP PUTI DROP
    SWAP
    3 GETI 3 ROLLD GETI 4 ROLL * 3 ROLLD GETI 4 ROLL +
    SWAP DROP 2 SWAP PUTI DROP

    @ Multiply numerators and denominators
    2 GETI 4 ROLLD GET 3 ROLLD
    2 GETI 3 ROLLD GET
    SWAP 4 ROLL * 3 ROLLD * \-> denom numer
    \<<

    denom numer GCD
    @ Reduce if non-zero GCD
    DUP IF THEN
         DUP
         numer SWAP / 'numer' STO
         denom SWAP / 'denom' STO
       ELSE
         DROP
       END

    @ Convert from an improper fraction to a mixed number
    numer denom / IP
    numer denom MOD
    denom

    @ Form the mixed number list
    3 \->LIST

    \>> @ end of scope of denom and numer

    @ DISPL the result
    32 DISPL

@ Convert the list to three elements on the stack
OBJ\-> DROP

END
\>> 'MULTI' STO

\<<

@ Convert elements on the stack to two lists.
3 \->LIST 4 ROLLD 3 \->LIST SWAP

@ Check that both denom's are non-zero.
DUP2 3 GET SWAP 3 GET AND IF NOT
THEN
   440 .5 BEEP
   "DIVI: zero in denom" 1 DISP 1 FREEZE
ELSE

    64 R\->B 131 R\->B BLANK PICT STO  @ Blank a 64X131 PICT

    @ Display the dividend
    SWAP 5 DISPL SWAP

    @ Now figure out where to place the divide sign
    1 GETI SWAP DROP \->STR SIZE 3 + 6 * NEG 65 + R\->B
    25 R\->B 2 \->LIST PICT SWAP
    " / " 3 \->GROB
    GOR

    @ And now the divisor
    20 DISPL
    25 R\->B 35 R\->B 2 \->LIST
    85 R\->B 35 R\->B 2 \->LIST LINE

    @ Multiply the two mixed numbers and DISPL the sum.

    @ Convert the two mixed numbers to improper fractions.
    3 GETI 3 ROLLD GETI 4 ROLL * 3 ROLLD GETI 4 ROLL +
    SWAP DROP 2 SWAP PUT
    SWAP
    3 GETI 3 ROLLD GETI 4 ROLL * 3 ROLLD GETI 4 ROLL +
    SWAP DROP 2 SWAP PUT
    SWAP

    @ Invert the quotient
    3 GETI 3 ROLLD DROP 2 GETI PUT SWAP 2 SWAP PUT

    @ Multiply numerators and denominators
    2 GETI 4 ROLLD GET 3 ROLLD
    2 GETI 3 ROLLD GET
    4 ROLL * 3 ROLLD * \-> denom numer
    \<<

    denom numer GCD
    @ Reduce if non-zero GCD
    DUP IF THEN
         DUP
         numer SWAP / 'numer' STO
         denom SWAP / 'denom' STO
       ELSE
         DROP
       END

    @ Convert from an improper fraction to a mixed number
    numer denom / IP
    numer denom MOD
    denom

    @ Form the mixed number list
    3 \->LIST

    \>> @ end of scope of denom and numer

    @ DISPL the result
    37 DISPL

@ Convert the list to elements on the stack
OBJ\-> DROP

END
\>> 'DIVI' STO

@  Computes the lcm using the
@  lcm(m,n) * gcd(m,n) = m * n

\<<
DUP2 AND
  IF    @ Check for 0 in the arguments.
  THEN
     @  Compute m * n then the GCD and finally divide
     DUP2 * 3 ROLLD GCD /
  ELSE
     @  Else return a zero
     DROP2 0
  END
\>> 'LCM' STO


@  This uses Euclid's algorithm to compute the gcd.
@  Euclid's algorithm as Stan remembered it is:
@  If you want the gcd of m and n, then iterate the following:
@  First express  m as q0*n + r0
@  then  express  n as q1*r0 +r1
@  iterate        rn as q(n+2)*r(n+1) + r(n+2)
@  when r(n+2) == 0 then r(n+1) is the gcd.

\<<
DUP2 AND     @ Check for a 0 in the arguments
  IF
  THEN
    @ Apply Euclid's algorithm
    DO DUP 3 ROLLD MOD DUP UNTIL NOT END DROP
  ELSE
    @ Return a zero if a 0 was in the arguments.
    DROP2 0
  END
\>> 'GCD' STO


\<<

0 DUP \-> row len midp           @ Grab the display row to use
                                 @ and set up a couple locals
\<<

@ First handle the whole number
@ Display the whole number only if it is non-zero
@ or the fraction is zero
1 GETI 3 ROLLD GETI SWAP DROP NOT 3 ROLL OR
IF THEN
  1 GETI \->STR
  DUP SIZE 'len' STO       @ save the length
  3 \->GROB            @ Get the whole number to a GROB
  PICT SWAP                          @ GOR it into the PICT
  65 len 6 * - R\->B row 4 + R\->B 2 \->LIST
  SWAP GOR
ELSE 2 END

@ Now for the fraction part.
@ First check the numerator.  If it's zero we're done.
@ Otherwise ...
@ computer the width of the fraction
GETI DUP IF THEN
   \->STR SIZE 'len' STO
   GETI \->STR SIZE len MAX 4 * 2 / 'midp' STO
   DROP 2

   @ Now place the numerator in the PICT
   GETI \->STR
   DUP SIZE 'len' STO        @ Save the length
   1 \->GROB PICT SWAP
   len 2 * NEG midp +
   66 + R\->B row R\->B 2 \->LIST
   SWAP GOR

   @ Now the fraction bar
   65 R\->B row 6 + R\->B 2 \->LIST
   65 midp 2 * + R\->B row 6 + R\->B 2 \->LIST LINE

   @ Finally the denominator
   GETI \->STR DUP SIZE 'len' STO
   1 \->GROB
   PICT SWAP
   len 2 * NEG midp +
   66 + R\->B row 8 + R\->B 2 \->LIST
   SWAP GOR
ELSE DROP END

    @ Display the result
    0 R\->B DUP 2 \->LIST PVIEW 3 FREEZE
    DROP                               @ DROP the GETI index

\>>  @ end scope of row and a couple locals

\>> 'DISPL' STO

@ Displays the 'fraction' on the top of the stack
\<<
  3 \->LIST DUP 3 GET
  IF NOT
     THEN
          440 .5 BEEP "DISP: zero in denom"
          1 DISP 1 FREEZE
     ELSE
          64 R\->B 131 R\->B BLANK PICT STO
          20 DISPL OBJ\-> DROP
  END
\>> 'DPLAY' STO


\<<
6 ROLL 6 ROLL 6 ROLL
\>> 'SWAPR' STO

{ S DPLAY 35.2
SWAPR 36.2 DIVI
65.1 MULTI 75.1
SUBTR 85.1 PLUS
95.1 } STOKEYS